home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
aed243a.zip
/
RSB3UTOG.MRG
< prev
next >
Wrap
Text File
|
1990-06-10
|
10KB
|
271 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RBBSSUB3.BAS to produce RSB3UTOG.BAS
* RBBSSUB3.BAS: Date 5-26-1990 Size 116300 bytes
* ------------[ Created 06-10-1990 01:59:29 ]------------
* REPLACING old line(s) by new
20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
' $PAGE
' NAME -- UpdtUpload
'
' INPUTS -- PARAMETER MEANING
' ZFileName$
' ZUpldDir$
' ZFileNameHold$
' ZShareIt
' ZFMSDirectory$
' ZWasQ!
' ZSecsUsedSession!
'
' OUTPUTS -- ZBytesInFile#
' ZSecsPerSession!
'
' PURPOSE -- Upon a successful upload, add entry to the upload
' directory and give any session time credit.
'
SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
IF ZGetExtDesc THEN _
GOTO 20723
GOSUB 20734
CALL TimeRemain (MinsRemaining)
IF ZPrivateDoor THEN _
WasX! = ZUpldTimeFactor! * ZWasQ! _
ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 20708
* ------[ first line different ]------
CALL QuickTPut1 ("Testing Upload. Please wait...") : _
CALL ReadDir (2,1)
IF EOF(2) THEN _
WasX$ = ZOutTxt$ : _
ZGSRAra$(1) = ZFileName$ : _
ZGSRAra$(2) = ZNodeWorkFile$ _
ELSE WasX$ = WasX$ + " " + _
ZFileName$ + " " + ZNodeWorkFile$
CALL ShellExit (WasX$)
CALL FindIt (ZNodeWorkFile$)
IF ZOK THEN _
IF LOF(2) > 2 THEN _
ZBytesInFile# = 0.0 : _
WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
CALL QuickTPut1 (WasX$) : _
CALL UpdtCalr (WasX$,2) : _
CALL KillWork (ZFileName$) : _
EXIT SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
20709 CALL QuickTPut1 ("Upload successful!")
WasX$ = DATE$
ZWasZ$ = LEFT$(WasX$,6) + _
RIGHT$(WasX$,2)
StrewTo$ = ""
UCat$ = ""
* REPLACING old line(s) by new
* ------[ first line different ]------
20710 CALL QuickTPut1 ("Please describe " + ZFileNameHold$ + _
" (Begin with '/' if for SYSOP only)")
CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
ZMaxDescLen - 4) + "..Max>")
CALL QuickTPut ("? ",0)
ZOutTxt$ = ""
ZSubParm = 1
ZParseOff = ZTrue
CALL TGet
CALL Carrier
IF ZSubParm = -1 THEN _
ZUserIn$ = "<description unavailable>": _
GOTO 20712
IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _
GOTO 20710
* REPLACING old line(s) by new
20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Add an extended description for " + _
ZFileNameHold$ + " ([Y],N)" : _
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL TGet : _
IF ZSubParm <> -1 THEN _
IF NOT ZNo THEN _
ZGetExtDesc = ZTrue : _
EXIT SUB
* REPLACING old line(s) by new
20726 ZWasDF$ = " >> uploaded << "
ZUplds = ZUplds + 1
ZGlobalUplds = ZGlobalUplds + 1
ZULBytes! = ZULBytes! + ZBytesInFile#
ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
CALL Muzak (7)
CALL TimeRemain (MinsRemaining)
ZTimeCredits! = ZTimeCredits! + WasX!
ZSecsPerSession! = ZSecsPerSession! + WasX!
IF ZPrivateDoor THEN _
WasX! = (WasX! - ZWasQ!) / 60 _
ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
WasX$ = STR$(FIX(WasX!*10.0))
WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
IF WasX! > 1 THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("The upload increased your session time by"+WasX$+" minutes.")
ZOutTxt$ = ZFirstName$
CALL NameCaps(ZOutTxt$)
CALL QuickTPut1 (ZOutTxt$ + ", thanks for the upload!")
ZGetExtDesc = ZFalse
EXIT SUB
* REPLACING old line(s) by new
31398 IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
* ------[ first line different ]------
IF INSTR("|@",ZActiveMenu$) = 0 THEN _
GOTO 31399
ZCursorLine = CSRLIN
ZCursorRow = POS(0)
LOCATE 25,1
WasD$ = SPACE$(79)
GOSUB 33210
LOCATE 25,1
WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
GOSUB 33210
CALL DelayTime (1)
LOCATE ZCursorLine,ZCursorRow
ZSubParm = 1
CALL Line25
GOTO 33970
* REPLACING old line(s) by new
41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
' $PAGE
'
' NAME -- DispTimeRemain
'
' INPUTS -- PARAMETER MEANING
' MinsRemaining
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
'
SUB DispTimeRemain (MinsRemaining) STATIC
CALL TimeRemain (MinsRemaining)
* ------[ first line different ]------
CALL QuickTPut(ZEmphasizeOff$,0)
CALL QuickTPut1 (MID$(STR$(MinsRemaining),2) + " min left")
END SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
43007 CALL QuickTPut1 ("Text File and Menu Graphics")
ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
ZSubParm = 1
ZTurboKey = -ZTurboKeyUser
CALL TGet
IF ZSubParm = -1 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
CALL QuickTPut1 ("Graphics Unchanged.") : _
EXIT SUB
CALL AllCaps (ZUserIn$(1))
ZWasGR = INSTR("NAC",ZUserIn$(1))
IF ZWasGR = 2 AND NOT ZEightBit THEN _
CALL QuickTPut1 ("Ascii unavailable. Requires 8 bit") : _
GOTO 43007
IF ZWasGR = 0 THEN _
GOTO 43006
ZWasGR = ZWasGR - 1
CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
END SUB
'
* REPLACING old line(s) by new
58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
' $PAGE
'
' NAME -- CheckNewBul
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Last DATE OF LOGON
' FORMAT MM/DD/YY
' ZActiveBulletins # OF BULLETING
' ZBulletinPrefix$ FILESPEC FOR BULLETINS
'
' OUTPUTS -- NumNewBullets NUMBER OF NEW BULLETINS
' NewBullets$ LIST OF NEW BULLET #'S
' ZWasQ WHERE Last BULLETIN STORED
' IN ZUserIn$()
' ZUserIn$() BULLETINS #'S THAT ARE NEW
' (2,3,4,...)
'
' PURPOSE -- Checks how many bulletins have system date
' at or later than date caller last logged on
'
SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
EXIT SUB
ZPrevPrefix$ = ZBulletinPrefix$
NumNewBullets = 0
NewBullets$ = ": "
BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
(10000# * (1900 + VAL(MID$(LastOn$,7,2))))
CALL FindIt (ZBulletinPrefix$ + ".FCK")
WasX = 0
* ------[ first line different ]------
CALL QuickTPut ("Checking New Bulletins",0)
IF ZOK THEN _
WHILE NOT EOF(2) : _
LINE INPUT #2,WasBN$ : _
GOSUB 58112 : _
WEND _
ELSE FOR WasI = 1 TO ZActiveBulletins : _
WasBN$ = MID$(STR$(WasI),2) : _
GOSUB 58112 : _
NEXT
ZWasQ = NumNewBullets + 1
IF NumNewBullets < 1 THEN _
NewBullets$ = ""
' CALL SkipLine (1)
CALL WipeLine(30)
ZOutTxt$ = "There are" + STR$(NumNewBullets) + _
" new bulletin(s) since last call" + _
NewBullets$
CALL QuickTPut1 (ZOutTxt$)
EXIT SUB
* REPLACING old line(s) by new
58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
' $PAGE
'
' NAME -- CountNewFiles
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Date of last logon
' UPLDS$ Latest uploads
'
' OUTPUTS -- NumNewFiles How many after last logon
' RptPrefix$ Set to "At least " if
' above is a minimum
'
' PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
' after date of last logon that the user can download
'
SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
31 * (VAL(MID$(LastOn$,1,2))) + _
VAL(MID$(LastOn$,4,2))
NumNewFiles = 1
NumUserFiles = 0
WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
Upld(NumNewFiles,1) > 0 AND _
NumNewFiles < UBOUND(Upld,1))
IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
NumUserFiles = NumUserFiles + 1
NumNewFiles = NumNewFiles + 1
WEND
IF Upld(NumNewFiles,1) < 1 THEN _
NumNewFiles = NumNewFiles - 1
IF BaseDate <= Upld(NumNewFiles,1) THEN _
* ------[ first line different ]------
RptPrefix$ = " at least" _
ELSE RptPrefix$ = ""
END SUB